home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tpl60n19.zip / TESTPRGS.ZIP / UNIT1.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-27  |  23KB  |  701 lines
  1. {$a+,n-,x-,s-,i-,r-,b-,v-}
  2.  
  3. unit Unit1;
  4. interface
  5.    uses mainvars;
  6.    procedure start;
  7.    procedure mile2060;
  8.  
  9. implementation
  10.    procedure start;
  11.  
  12.  
  13.    begin (* PARA *)
  14.  
  15.    {First two assignments use integer right-hand sides.}
  16.    Zero := 0;
  17.    One := 1;
  18.    Two := One + One;
  19.    Three := Two + One;
  20.    Four := Three + One;
  21.    Five := Four + One;
  22.    Eight := Four + Four;
  23.    Nine := Three * Three;
  24.    TwentySeven := Nine * Three;
  25.    ThirtyTwo := Four * Eight;
  26.    TwoForty := Four * Five * Three * Four;
  27.    MinusOne := -One;
  28.    Half := One / Two;
  29.    OneAndHalf := One + Half;
  30.  
  31.    NoErrors [Failure] := 0;
  32.    NoErrors [SeriousDefect] := 0;
  33.    NoErrors [Defect] := 0;
  34.    NoErrors [Flaw] := 0;
  35.    PageNo := 0;
  36. {=============================================}
  37.    Milestone := 0;
  38. {=============================================}
  39.    writeln ('Type any character to start the program.');
  40.    { assign(input,'con:');} { for TURBO Pascal version 2 }
  41.    { reset (input); }       { for old Cray Pascal }
  42.    while not eoln (input) do
  43.       read (input, ch);
  44.    Instructions;
  45.    Pause;
  46.    Heading;
  47.    Pause;
  48.    Characteristics;
  49.    Pause;
  50.    History;
  51. {=============================================}
  52.    Milestone := 7;
  53. {=============================================}
  54.    Pause;
  55.    writeln ('Program is now RUNNING tests on small integers:');
  56.    TestCondition (Failure, (Zero + Zero = Zero) and (One - One = Zero)
  57.          and (One > Zero)
  58.          and (One + One = Two), ' 0+0<>0  or 1-1<>0  or  1<=0  or 1+1<>2 '
  59.          );
  60.    Z := - Zero;
  61.    if Z <> 0.0 then
  62.       begin
  63.       NoErrors [Failure] := NoErrors [Failure] + 1;
  64.       writeln ('Comparison alleges that -0.0 is Non-zero!');
  65.       U2 := 0.001;
  66.       Radix := 1;
  67.       TestPartialUnderflow;
  68.       end;
  69.    TestCondition (Failure, (Three = Two + One) and (Four = Three + One)
  70.          and (Four + Two * (- Two) = Zero)
  71.          and (Four - Three - One = Zero),
  72.          ' 3<>2+1, 4<>3+1, 4+2*(-2)<>0 or 4-3-1<>0');
  73.    TestCondition (Failure, (MinusOne = - One)
  74.          and (MinusOne + One = Zero ) and (One + MinusOne = Zero)
  75.          and (MinusOne + abs (One) = Zero)
  76.          and (MinusOne + MinusOne * MinusOne = Zero),
  77.          '-1+1<>0, -1+abs(1)<>0 or -1+(-1)*(-1)<>0');
  78.    TestCondition (Failure, Half + MinusOne + Half = Zero,
  79.          '   1/2  + (-1) + 1/2 <> 0               ');
  80. {=============================================}
  81.    Milestone := 10;
  82. {=============================================}
  83.    TestCondition (Failure, (Nine = Three * Three)
  84.          and (TwentySeven = Nine * Three) and (Eight = Four + Four)
  85.          and (ThirtyTwo = Eight * Four)
  86.          and (ThirtyTwo - TwentySeven - Four - One = Zero),
  87.          '9<>3*3, 27<>9*3, 32<>8*4 or 32-27-4-1<>0');
  88.    TestCondition (Failure, (Five = Four + One)
  89.          and (TwoForty = Four * Five * Three * Four)
  90.          and (TwoForty / Three - Four * Four * Five = Zero)
  91.          and ( TwoForty / Four - Five * Three * Four = Zero)
  92.          and ( TwoForty / Five - Four * Three * Four = Zero),
  93.          '5<>4+1,240/3<>80,240/4<>60, or 240/5<>48');
  94.    if NoErrors [Failure] = 0 then
  95.       begin
  96.       writeln (' -1, 0, 1/2, 1, 2, 3, 4, 5, 9, 27, 32 & 240 are O.K.');
  97.       writeln
  98.       end;
  99.    writeln ('Searching for Radix and Precision.');
  100.    W := One;
  101.    repeat
  102.       W := W + W;
  103.       Y := W + One;
  104.       Z := Y - W;
  105.       Y := Z - One;
  106.    until (MinusOne + abs (Y) >= Zero);
  107. {.. now W is just big enough that |((W+1)-W)-1| >= 1 ...}
  108.    Precision := 0;
  109.    Y := One;
  110.    repeat
  111.       Radix := W + Y;
  112.       Y := Y + Y;
  113.       Radix := Radix - W;
  114.    until (Radix <> Zero);
  115.    if Radix < Two then
  116.       Radix := One;
  117.    writeln ('Radix = ', Radix);
  118.    if Radix <> 1 then
  119.       begin
  120.       W := One;
  121.       repeat
  122.          Precision := Precision + One;
  123.          W := W * Radix;
  124.          Y := W + One;
  125.       until (Y - W) <> One;
  126.    {... now W = Radix^Precision is barely too big to satisfy (W+1)-W = 1
  127.                                           ...}
  128.       end;
  129.    U1 := One / W;
  130.    U2 := Radix * U1;
  131.    writeln ('Closest relative separation found is U1 = ', U1);
  132.    writeln;
  133.    writeln ('Recalculating radix and precision');
  134.    E0 := Radix;
  135.    E1 := U1;
  136.    E9 := U2;
  137. {save old values}
  138.    X := Four / Three;
  139.    Third := X - One;
  140.    F6 := Half - Third;
  141.    X := F6 + F6;
  142.    X := abs (X - Third);
  143.    if X < U2 then
  144.       X := U2;
  145. {... now X = (unknown no.) ulps of 1+...}
  146.    repeat
  147.       U2 := X;
  148.       Y := Half * U2 + ThirtyTwo * U2 * U2;
  149.       Y := One + Y;
  150.       X := Y - One;
  151.    until (U2 <= X) or (X <= Zero);
  152. {... now U2 = 1 ulp of 1 + ... }
  153.    X := Two / Three;
  154.    F6 := X - Half;
  155.    Third := F6 + F6;
  156.    X := Third - Half;
  157.    X := abs (X + F6);
  158.    if X < U1 then
  159.       X := U1;
  160. {... now  X = (unknown no.) ulps of 1 -... }
  161.    repeat
  162.       U1 := X;
  163.       Y := Half * U1 + ThirtyTwo * U1 * U1;
  164.       Y := Half - Y;
  165.       X := Half + Y;
  166.       Y := Half - X;
  167.       X := Half + Y;
  168.    until (U1 <= X) or (X <= Zero);
  169. {... now U1 = 1 ulp of 1 - ... }
  170.    if U1 = E1 then
  171.       writeln (' confirms closest relative separation U1 .')
  172.    else
  173.       writeln (' gets better closest relative separation U1 = ', U1);
  174.    W := One / U1;
  175.    F9 := (Half - U1) + Half;
  176.    Radix := Int (0.01 + U2 / U1);
  177.    if Radix = E0 then
  178.       writeln ('Radix confirmed.')
  179.    else
  180.       writeln ('MYSTERY: recalculated Radix = ', Radix);
  181.    TestCondition (Defect, Radix <= Eight + Eight,
  182.          'Radix is too big: roundoff problems     ');
  183.    TestCondition (Flaw, (Radix = Two) or (Radix = 10)
  184.          or (Radix = One), 'Radix is not as good as 2 or 10.        ');
  185.    end (*start*);
  186.  
  187.    procedure mile2060;
  188.    begin
  189.  
  190. {=============================================}
  191.    Milestone := 20;
  192. {=============================================}
  193.    TestCondition (Failure, F9 - Half < Half,
  194.          ' (1-U1)-1/2 < 1/2 is FALSE, prog. fails?');
  195.    X := F9;
  196.    I := 1;
  197.    Y := X - Half;
  198.    Z := Y - Half;
  199.    TestCondition (Failure, (X <> One)
  200.          or (Z = Zero), 'Comparison is fuzzy,X=1 but X-1/2-1/2<>1');
  201.    X := One + U2;
  202.    I := 0;
  203. {=============================================}
  204.    Milestone := 25;
  205. {=============================================}
  206.    BMinusU2 := Radix - One;
  207.    BMinusU2 := (BMinusU2 - U2) + One;
  208.    if Radix <> One then
  209.       begin {... BMinusU2 = nextafter(Radix, 0) }
  210.       X := - TwoForty * ln (U1) / ln (Radix);
  211.       Y := Int (Half + X);
  212.       if abs (X - Y) * Four < One then
  213.          X := Y;
  214.       Precision := X / TwoForty;
  215.       Y := Int (Half + Precision);
  216.       if abs (Precision - Y) * TwoForty < Half then
  217.          Precision := Y;
  218.    { Purify integers }
  219.       end;
  220.    if (Precision <> Int (Precision)) or (Radix = One) then
  221.       begin
  222.       writeln ('Precision cannot be characterized by an integer',
  223.             ' number of sig. digits,');
  224.       writeln ('but, by itself, this is a minor flaw.');
  225.       end;
  226.    if Radix = One then
  227.       writeln ('logarithmic encoding has precision characterized',
  228.             'solely by U1.')
  229.    else
  230.       writeln ('The number of significant digits of the Radix is ',
  231.             Precision);
  232.    TestCondition (SeriousDefect, U2 * Nine * Nine * TwoForty < One,
  233.          ' Precision worse than 5 decimal figures ');
  234. {=============================================}
  235.    Milestone := 30;
  236. {=============================================}
  237. { Test for extra-precise subepressions }
  238.    X := abs (((Four / Three - One) - One / Four) * Three - One / Four);
  239.    repeat
  240.       Z2 := X;
  241.       X := (One + (Half * Z2 + ThirtyTwo * Z2 * Z2)) - One;
  242.    until (Z2 <= X) or (X <= Zero);
  243.    Y := abs ((Three / Four - Two / Three) * Three - One / Four);
  244.    Z := Y;
  245.    X := Y;
  246.    repeat
  247.       Z1 := Z;
  248.       Z := (One / Two - ((One / Two - (Half * Z1 + ThirtyTwo * Z1 * Z1))
  249.             + One / Two)) + One / Two;
  250.    until (Z1 <= Z) or (Z <= Zero);
  251.    repeat
  252.       repeat
  253.          Y1 := Y;
  254.          Y := (Half - ((Half - (Half * Y1 + ThirtyTwo * Y1 * Y1)) + Half
  255.                )) + Half;
  256.       until (Y1 <= Y) or (Y <= Zero);